home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.001 / DFBTREE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-19  |  61KB  |  1,355 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {  The index routines used in TTT Gold were developed by Dean Farwell II   }
  7. {  and are an adaptation of his excellent TBTREE database tools.           }
  8. {                                                                          }
  9. {                   Copyright 1988-1994 Dean Farwell II                    }
  10. {        Portions Copyright 1986-1995  TechnoJock Software, Inc.           }
  11. {                           All Rights Reserved                            }
  12. {                          Restricted by License                           }
  13. {--------------------------------------------------------------------------}
  14.  
  15.                      {********************************}
  16.                      {       Unit:   DFBTREE          }
  17.                      {********************************}
  18.  
  19. unit DFBtree;
  20.  
  21. (*****************************************************************************)
  22. (*                                                                           *)
  23. (*                      B T R E E   R O U T I N E S                          *)
  24. (*                                                                           *)
  25. (*****************************************************************************)
  26.  
  27.  
  28. (*////////////////////////// I N T E R F A C E //////////////////////////////*)
  29.  
  30. interface
  31.  
  32. uses
  33.     DFBTreUt;
  34.  
  35. const
  36.     MAXVALSIZE    = 245;                          (* max value size in index *)
  37.  
  38. type
  39.     VSizeType     = 1 .. MAXVALSIZE;         (* size range for index entries *)
  40.  
  41.     ValidationError = (NOERROR,PRECERROR,IFILEERROR);
  42.  
  43.     ValueArray = Array [VSizeType] of Byte;
  44.  
  45.     TreeCursor = record
  46.          prNum : PrNumber;
  47.          entryNum : Byte;
  48.          valid : Boolean;
  49.          indexField : Integer;
  50.          end;
  51.  
  52.  
  53.           (* The following files are located in BTREE3.INC *)
  54.  
  55. (* This routine will set the tree cursor to the front of the index.  In
  56.    other words, it will point to the first entry in the index.  Remember, the
  57.    index is ordered by the value of each entry.  It will also return the
  58.    logical record associated with the first entry in the index.  It will
  59.    return 0 only if there is no first entry (the index is empty).  This
  60.    routine should be called if you want to start at the beginning of an index
  61.    and want to retrieve logical record numbers in order of entry.            *)
  62.  
  63. function UsingCursorGetFirstLr(iFName : FnString;
  64.                                var fId : File          (* var for speed only *)
  65.                                ) : LrNumber;
  66.  
  67.  
  68. (* This routine will set the tree cursor to the end of the index.  In
  69.    other words, it will point to the first entry in the index.  Remember, the
  70.    index is ordered by the value of each entry.  It will also return the
  71.    logical record associated with the last entry in the index.  It will
  72.    return 0 only if there is no last entry (the index is empty).  This
  73.    routine should be called if you want to start at the end of an index
  74.    and want to retrieve logical record numbers in reverse order of entry.   *)
  75.  
  76. function UsingCursorGetLastLr(iFName : FnString;
  77.                               var fId : File           (* var for speed only *)
  78.                               ) : LrNumber;
  79.  
  80. (* This routine will set the tree cursor to the end of the index.  In other
  81.    words, it will point to the last entry in the index.  Remember, the index
  82.    is ordered by the value of each entry.  It will also return the logical
  83.    record associated with the last entry in the index.  It will return 0 only
  84.    if there is no first entry (the index is empty).  This routine should be
  85.    called if you want to start at the end of an index and want to retrieve
  86.    logical record numbers in order of entry.                                 *)
  87.  
  88. (*\*)
  89. (* This routine is the same as UsingCursorAndValueGetLr except that this
  90.    routine will set the tree cursor to the location of the first value in the
  91.    index which is greater than or equal to paramValue.  It will also return
  92.    the logical record associated with this entry.  It will return 0 if there
  93.    is no entry which is greater than or equal to this value.                 *)
  94.  
  95. function UsingCursorAndGEValueGetLr(iFName : FnString;
  96.                                     var fId : File;    (* var for speed only *)
  97.                                     var paramValue;
  98.                                     partial : Boolean) : LrNumber;
  99.  
  100. (* This routine will move the cursor to the right one entry and return the
  101.    value associated with this entry.  It will return 0 if the cursor was not
  102.    valid (not pointing to an entry) or if there is no next entry (you are at
  103.    end of index).  This routine should be called if you want to move the
  104.    cursor to the next larger entry from the present cursor position and
  105.    retrieve the associated logical record number.  This routine should not
  106.    normally be used until the cursor has been positioned using one of the
  107.    three previous positioning routines.                                      *)
  108.  
  109. function UsingCursorGetNextLr(iFName : FnString;
  110.                               var fId : File          (* var for speed only *)
  111.                              ) : LrNumber;
  112.  
  113.  
  114. (* This routine will move the cursor to the left one entry and return the
  115.    value associated with this entry.  It will return 0 if the cursor was not
  116.    valid (not pointing to an entry) or if there is no next entry (you are at
  117.    end of index).  This routine should be called if you want to move the
  118.    cursor to the next larger entry from the present cursor position and
  119.    retrieve the associated logical record number.  This routine should not
  120.    normally be used until the cursor has been positioned using one of the
  121.    previous positioning routines.                                            *)
  122.  
  123. function UsingCursorGetPrevLr(iFName : FnString;
  124.                               var fId : File          (* var for speed only *)
  125.                               ) : LrNumber;
  126.  
  127.  
  128. (* This routine will not move the cursor.  It will return the logical record
  129.    number associated with the current cursor position.  It will return 0 only
  130.    if the current cursor position is not valid.                              *)
  131.  
  132. function UsingCursorGetCurrLr(iFName : FnString;
  133.                               var fId : File           (* var for speed only *)
  134.                               ) : LrNumber;
  135.  
  136.  
  137. (* This routine will not move the cursor.  It will return the index entry
  138.    (data value) associated with the current cursor position.  If the current
  139.    cursor position is not valid, paramValue will be returned unchanged.  You
  140.    can use UsingCursorGetCurrLr to check the cursor before calling this
  141.    routine, if desired.                                                      *)
  142.  
  143. procedure UsingCursorGetCurrValue(iFName : FnString;
  144.                                   var fId : File;      (* var for speed only *)
  145.                                   var paramValue);
  146.  
  147.  
  148. (* This routine will allow you to save a cursor in memory.  The current state
  149.    of the cursor will be passed back to you in the parameter cursor.  It is
  150.    handy if you want to keep track of where you are in a list or check values
  151.    associated with a cursor.                                                 *)
  152.  
  153.  
  154.           (* The following files are located in BTREE4.INC *)
  155.  
  156. (* This routine will create an index file with the file name as specified
  157.    by iFName.  The valSize parameter specifies the size of the index
  158.    entries.  The easiest way to determine this is to use the SizeOf
  159.    function.  The valType parameter specifies the type for the index
  160.    entries.  The types supported are those enumerated by the ValueType
  161.    enumerated type.
  162.  
  163.    note - Extremely important - WARNING - for STRINGVALUE indexes only - the
  164.    valSize must be 1 greater than the number of characters of the longest
  165.    string.  This will allow 1 byte for the string length to be stored.
  166.    for example - if 'abc' is the longest string then valSize = 4.            *)
  167.  
  168. procedure CreateIndexFile(iFName : FnString;
  169.                           var fId : File;
  170.                           valSize : VSizeType;
  171.                           valType : ValueType;
  172.                           indexedField : Integer;
  173.                           upperCase : Boolean);
  174.  
  175. (*\*)
  176. (* This routine will insert a value and its associated logical record number
  177.    into the given index file.  This routine will guard against duplicate
  178.    entries. An index should have no more than one occurence of any
  179.    lrNum,paramValue pair (no two entries match on paramValue and lrNum).  This
  180.    routine assures this by calling DeleteValueFromBTree prior to performing
  181.    the insert.  This will get rid of a previous occurence if it exists.      *)
  182.  
  183. procedure InsertValueInBTree(iFName : FnString;
  184.                              var fId : File;           (* var for speed only *)
  185.                              lrNum : LRNumber;
  186.                              var paramValue);
  187.  
  188.  
  189. procedure DeleteValueFromBTree(iFName : FnString;
  190.                                var fId : File;         (* var for speed only *)
  191.                                lrNum : LrNumber;
  192.                                var paramValue);
  193.  
  194. (* This routine will start at the root node and return the number of levels
  195. that exist in a BTree.  The index file name is the only required input.      *)
  196.  
  197. function NumberOfBTreeLevels(iFName : FnString;
  198.                              var fId : File            (* var for speed only *)
  199.                              ) : Byte;
  200.  
  201.  
  202. (* This routine will search an index and determine whether the given logical
  203.    record number is in the index.  If it is, TRUE is returned in found and the
  204.    value associated with the logical record number is returned in paramValue.
  205.    If it is not found, found will be returned as FALSE and paramValue will
  206.    remain unchanged.  This is primarily used for debugging or determining if
  207.    an index has somehow been damaged.                                        *)
  208.  
  209.  
  210. procedure FindLrNumInBTree(iFName : FnString;
  211.                            var fId : File;             (* var for speed only *)
  212.                            lrNum : LrNumber;
  213.                            var paramValue;
  214.                            var found : Boolean);
  215.  
  216.  
  217. (* This routine will return a count of the number of entries in the index.   *)
  218.  
  219. function IndexEntryCount(iFName : FnString;
  220.                          var fId : File                (* var for speed only *)
  221.                          ) : LrNumber;
  222.  
  223.  
  224. (* This routine will print out information regarding the index file.  It is
  225.    designed to aid in my debugging, but is available for your use as well.
  226.    The nodeInfo paramter is used to specify whether you want the information
  227.    for each node in the index to be printed.                                 *)
  228.  
  229. procedure PrintBTreeInfo(iFName : FnString;
  230.                          var fId : File;               (* var for speed only *)
  231.                          nodeInfo : Boolean;
  232.                          var lst : PrintTextDevice);
  233.  
  234.  
  235. (* This routine returns the field number of the indexed field in support of
  236.    GoldDB                                                                    *)
  237.  
  238. function GetIndexedField(iFName : FnString;
  239.                          var fId : File) : Integer;    (* var for speed only *)
  240.  
  241.  
  242. (* This function returns the record number corresponding to the given entry
  243.    number.  An entry number is the relative number from the beginning of the
  244.    index.  In other words, entry number one is the first entry in the index.
  245.    It will return NULL if there is no corresponding record number.  This can
  246.    only happen if entryNum > number of entries in the index.                 *)
  247.  
  248.  
  249. function GetBTreeEntryLR(iFName : FnString;
  250.                          var fId : File;               (* var for speed only *)
  251.                          entryNum : LrNumber) : LrNumber;
  252.  
  253.  
  254. (* This routine returns TRUE if the index is all upper case                 *)
  255.  
  256. function GetUpperCaseFlag(iFName : FnString;
  257.                           var fId : File) : Boolean;   (* var for speed only *)
  258.  
  259.  
  260. (* This routine will perform a partial or a full validation of an index file.
  261.    (depending on the value of the variable Partial).  A partial check will
  262.    validate that the pRec record (record 0) is intact and that the file
  263.    structure is valid.  A full validation will perform an additional check
  264.    to ensure that the data file and the index file are synchronized. The
  265.    routine will return one of the following values:
  266.  
  267.               NOERROR
  268.               PRECERROR
  269.               IFILEERROR                                                     *)
  270.  
  271. function ValidateBTree(iFName : FnString;
  272.                        var fId : File                 (* var for speed only *)
  273.                        ): ValidationError;
  274.  
  275. (*\*)
  276. (*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)
  277.  
  278. implementation
  279.  
  280. uses
  281.     DFPage;
  282.  
  283.  
  284. (*****************************************************************************)
  285. (*                                                                           *)
  286. (*   I N S E R T  /  D E L E T E  /  M I S C    B T R E E   R O U T I N E S  *)
  287. (*                                                                           *)
  288. (*****************************************************************************)
  289.  
  290. (* These definitions and routines are the 'guts' of the BTREE unit.  This
  291.    contain all routines which manipulate the index nodes (physical records)
  292.    and bitmaps, put values and logical record numbers in and out of the
  293.    indexes and perform other important functions.  Most of the routines in
  294.    this file are internal to the BTREE unit, although several are not.       *)
  295.  
  296. const
  297.     NULL     : RecordNumber = 0;                   (* used to dilineate null
  298.                                                                record number *)
  299.  
  300.     VERSIONINFO = 'GOLDDB INDEX V1.0';
  301.  
  302. type
  303.     NodeType = (INVALIDNODETYPE,INDEXNODE,SEQUENCENODE);
  304.                              (* INVALIDNODETYPE is not used for anything.
  305.                                 It serves one purpose.  It gives positive
  306.                                 values to the two remaining legal values
  307.                                 for this enumerated type.  I didn't want
  308.                                 to have zero be valid.  This helped in
  309.                                 debugging and there is no reason to
  310.                                 change it.                                   *)
  311.  
  312.  
  313.  
  314. (* These parameters are contained in the first record (0) in the index file
  315.  
  316.      variable        parameter               type         range
  317.      --------        ---------               ----         -----
  318.       version        version information  String[20]      N/A
  319.       nextAvail      next available node  NodePtrType     0 - MAXLONGINT
  320.       firstBMRec     first bitmap record  PrNumber        0 - MAXLONGINT
  321.       lastBMRec      last bitmap record   PrNumber        0 - MAXLONGINT
  322.       vSize          value size           Byte            1 - 245
  323.       rNode          root node            Longint         1 - MAXLONGINT
  324.       fSNode         first sequence node  Longint         1 - MAXLONGINT
  325.       lSNode         last  sequence node  LongInt         1 - MAXLONGINT
  326.       vType          value type           ValueType       0 = INVALIDVALUE
  327.                                                           1 = BYTEVALUE
  328.                                                           2 = SHORTINTVALUE
  329.                                                           3 = INTEGERVALUE
  330.                                                           4 = LONGINTVALUE
  331.                                                           5 = WORDVALUE
  332.                                                           6 = STRINGVALUE
  333.                                                           7 = REALVALUE
  334.                                                           8 = SINGLEVALUE
  335.                                                           9 = DOUBLEVALUE
  336.                                                          10 = EXTENDEDVALUE
  337.                                                          11 = COMPVALUE
  338.                                                          12 = BYTEARRAYVALUE
  339.       cursor         tree cursor info     TreeCursor     N/A
  340.       iField         indexed field - Gold DB only
  341.       upperCaseFlag  Gold DB only                                            *)
  342.  
  343. (*\*)
  344. type
  345.     NodePtrType   = PrNumber;                (* pointer to index records     *)
  346.  
  347.     ParameterRecord = record
  348.          version    : String[20];         (* version info                    *)
  349.          nextAvail  : NodePtrType;        (* next index node available       *)
  350.          firstBMRec : PrNumber;           (* first record used for bitmap    *)
  351.          lastBMRec  : PrNumber;           (* last record used for bitmap     *)
  352.          vSize      : VSizeType;
  353.          rNode      : NodePtrType;
  354.          fSNode     : NodePtrType;
  355.          lSNode     : NodePtrType;
  356.          vType      : ValueType;
  357.          cursor     : TreeCursor;
  358.          iField     : Integer;            (* Indexed Field - Gold DB only   *)
  359.          upperCaseFlag : Boolean;         (* Gold DB only                   *)
  360.          end;
  361.  
  362.  
  363. (* These parameters is found in every index and sequence node in the index
  364.    file.
  365.  
  366.      variable      parameter       location   size   type    range
  367.      --------      ---------       --------   ----   ----    -----
  368.       prev         prev sequence     503        4    int     0 - MAXINT
  369.                       node
  370.  
  371.       next         next sequence     507        4    int     0 - MAXINT
  372.                       node
  373.  
  374.       nType        node type         511        1    Byte    0 = INVALIDNODETYPE
  375.                                                              1 = INDEXNODE
  376.                                                              2 = SEQUENCENODE
  377.  
  378.       vCnt         value count       512        1    Byte    1 - MAXBYTE     *)
  379.  
  380.  
  381. const
  382.     PREVLOC   = 503;
  383.     NEXTLOC   = 507;
  384.     NTYPELOC  = 511;
  385.     VCNTLOC   = 512;
  386.     MAXUSABLE = 502;  (* how much can be used for entries and record numbers *)
  387.  
  388.  
  389. var
  390.     mustMoveCursor : Boolean;
  391.  
  392. (*\*)
  393. (* This routine will return the record number for the first unused index
  394.    record (node).  If the first unused node is the first used bitmap record
  395.    then the bitmap records will be moved down to free up disk space.  The
  396.    number of physical pages freed up depends on the size of the index file   *)
  397.  
  398. function FirstUnusedIndexRecord(var iFName : FnString; (* var for speed only *)
  399.                                 var fId : File;        (* var for speed only *)
  400.                                 var pRec : ParameterRecord) : NodePtrtype;
  401.  
  402. var
  403.     newRecord : NodePtrType;                 (* record number to be returned *)
  404.     recsToMove : PrNumber;
  405.  
  406.     begin
  407.     newRecord := pRec.nextAvail;                  (* record number to return *)
  408.     pRec.nextAvail := FindNextAvailInBitmap(iFName,fId,pRec.firstBMRec,
  409.                                             pRec.lastBMRec,newRecord);
  410.     if BTreeErrorOccurred then Exit;
  411.  
  412.     if newRecord = pRec.firstBMRec then
  413.         begin                                 (* need to move bitmap records *)
  414.         if newRecord <= 4 then
  415.             begin
  416.             recsToMove := 1;
  417.             end
  418.         else
  419.             begin
  420.             if newRecord <= 10 then
  421.                 begin
  422.                 recsToMove := 3;
  423.                 end
  424.             else
  425.                 begin
  426.                 recsToMove := 5;
  427.                 end;
  428.             end;
  429.  
  430.         MoveRecords(iFName,fId,pRec.firstBMRec,pRec.lastBMRec,recsToMove);
  431.         if BTreeErrorOccurred then Exit;
  432.         end;
  433.  
  434.     FirstUnUsedIndexRecord := newRecord;         (* record number to return *)
  435.     end;                            (* end of FirstUnusedIndexRecord routine *)
  436.  
  437.  
  438. (* This routine will delete a node from the index file by setting the
  439.    appropriate bitmap bit to zero                                            *)
  440.  
  441. procedure DeleteIndexRecord(var iFName : FnString;     (* var for speed only *)
  442.                             var fId : File;        (* var for speed only *)
  443.                             thisNode : NodePtrType;
  444.                             var pRec : ParameterRecord);
  445.  
  446.     begin
  447.     SetBitInBitmap(iFName,fId,pRec.firstBMRec,thisNode,0); (* mark as unused *)
  448.     if BTreeErrorOccurred then Exit;
  449.  
  450.     ReleasePage(iFName,thisNode);  (* more for efficiency  .. not required   *)
  451.     if thisNode < pRec.nextAvail then
  452.         begin
  453.         pRec.nextAvail := thisNode;
  454.         end;
  455.     end;                                 (* end of DeleteIndexRecord routine *)
  456.  
  457. (*\*)
  458. (* This routine will insert a node between prevNode and nextNode in a node list.
  459.    It will accomplish this by setting the prev and next ptrs as necessary
  460.    for a node and its prev and next nodes.  Obviously, the node ptr and the
  461.    next and prev node pointers must be known.  If the node type is
  462.    SEQUENCENODE and this node is the first node in the sequential list, the
  463.    parameter record will be updated to reflect this change (the sNode parameter
  464.    will be set to this node ).                                               *)
  465.  
  466. procedure InsertNodeInList(var iFName : FnString;      (* var for speed only *)
  467.                            var fId : File;             (* var for speed only *)
  468.                            thisNode : NodePtrType;
  469.                            var prevNode;
  470.                            var nextNode;
  471.                            var pRec : ParameterRecord);
  472.  
  473. var
  474.     pg : SinglePage;
  475.     tempPrevNode,
  476.     tempNextNode : NodePtrType;
  477.  
  478.     begin
  479.     Move(prevNode,tempPrevNode,SizeOf(NodePtrType));
  480.     Move(nextNode,tempNextNode,SizeOf(NodePtrType));
  481.  
  482.     FetchPage(iFName,fId,thisNode,pg);
  483.     if BTreeErrorOccurred then Exit;
  484.  
  485.     Move(prevNode,pg[PREVLOC],SizeOf(NodePtrType));
  486.     Move(nextNode,pg[NEXTLOC],SizeOf(NodePtrType));
  487.  
  488.     StorePage(iFName,fId,thisNode,pg);
  489.     if BTreeErrorOccurred then Exit;
  490.  
  491.     if tempPrevNode <> NULL then
  492.         begin
  493.         FetchPage(iFName,fId,tempPrevNode,pg);
  494.         if BTreeErrorOccurred then Exit;
  495.         Move(thisNode,pg[NEXTLOC],SizeOf(NodePtrType));
  496.         StorePage(iFName,fId,tempPrevNode,pg);
  497.         if BTreeErrorOccurred then Exit;
  498.         end
  499.     else
  500.         begin                               (* new node is first node *)
  501.         if pg[NTYPELOC] = Byte(SEQUENCENODE) then
  502.             begin             (* set first seq node pointer to this new node *)
  503.             pRec.fSNode := thisNode;
  504.             end;
  505.         end;
  506.     if tempNextNode <> NULL then
  507.         begin
  508.         FetchPage(iFName,fId,tempNextNode,pg);
  509.         if BTreeErrorOccurred then Exit;
  510.         Move(thisNode,pg[PREVLOC],SizeOf(NodePtrType));
  511.         StorePage(iFName,fId,tempNextNode,pg);
  512.         if BTreeErrorOccurred then Exit;
  513.         end
  514.     else
  515.         begin                                       (* new node is last node *)
  516.         if pg[NTYPELOC] = Byte(SEQUENCENODE) then
  517.             begin              (* set last seq node pointer to this new node *)
  518.             pRec.lSNode := thisNode;
  519.             end;
  520.         end;
  521.     end;                                  (* end of InsertNodeInList routine *)
  522.  
  523. (*\*)
  524. (* This routine will delete a node from a node list and set its neighbors prev
  525.    and next node pointers as appropriate.  It will also delete the record from
  526.    the index file to allow it to be reused.                                  *)
  527.  
  528. procedure DeleteNodeFromList(var iFName : FnString;    (* var for speed only *)
  529.                              var fId : File;           (* var for speed only *)
  530.                              thisNode : NodePtrType;
  531.                              var pRec : ParameterRecord);
  532.  
  533. var
  534.     pg : SinglePage;
  535.     prevNode,
  536.     nextNode : NodePtrType;
  537.  
  538.     begin
  539.     FetchPage(iFName,fId,thisNode,pg);
  540.     if BTreeErrorOccurred then Exit;
  541.  
  542.     Move(pg[PREVLOC],prevNode,SizeOf(NodePtrType));     (* get Prev node ptr *)
  543.     Move(pg[NEXTLOC],nextNode,SizeOf(NodePtrType));     (* get Next node ptr *)
  544.  
  545.     if prevNode <> NULL then
  546.         begin
  547.         FetchPage(iFName,fId,prevNode,pg);
  548.         if BTreeErrorOccurred then Exit;
  549.         Move(nextNode,pg[NEXTLOC],RNSIZE);
  550.         StorePage(iFName,fId,prevNode,pg);
  551.         if BTreeErrorOccurred then Exit;
  552.         end
  553.     else
  554.         begin
  555.         if NodeType(pg[NTYPELOC]) = SEQUENCENODE then
  556.             begin
  557.             pRec.fSNode := nextNode;
  558.             end;
  559.         end;
  560.  
  561.     if nextNode <> NULL then
  562.         begin
  563.         FetchPage(iFName,fId,nextNode,pg);
  564.         if BTreeErrorOccurred then Exit;
  565.         Move(prevNode,pg[PREVLOC],RNSIZE);
  566.         StorePage(iFName,fId,nextNode,pg);
  567.         if BTreeErrorOccurred then Exit;
  568.         end
  569.     else
  570.         begin
  571.         if NodeType(pg[NTYPELOC]) = SEQUENCENODE then
  572.             begin
  573.             pRec.lSNode := nextNode;
  574.             end;
  575.         end;
  576.  
  577.     DeleteIndexRecord(iFName,fId,thisNode,pRec);     (* get rid of phys rec *)
  578.     if BTreeErrorOccurred then Exit;
  579.     end;                                        (* end of DeleteNodeFromList *)
  580.  
  581. (*\*)
  582. (* This routine will create a new node and set the node type parameter
  583.    and will insert this node between the prev node and the next node
  584.    in the node linked list.  Remember, this level linked list is required to
  585.    facilitate deletions.                                                     *)
  586.  
  587. function CreatedNode(var iFName : FnString;            (* var for speed only *)
  588.                      var fId : File;                   (* var for speed only *)
  589.                      var prevNode;
  590.                      var nextNode;
  591.                      nType : NodeType;
  592.                      var pRec : ParameterRecord) : NodePtrType;
  593.  
  594. var
  595.     pg : SinglePage;
  596.     newNode : NodePtrType;
  597.  
  598.     begin
  599.     newNode := FirstUnUsedIndexRecord(iFName,fId,pRec);
  600.     if BTreeErrorOccurred then Exit;
  601.  
  602.     FillChar(pg,PAGESIZE,0);
  603.     pg[NTYPELOC] := Byte(nType);                        (* set the node type *)
  604.  
  605.     StorePage(iFName,fId,newNode,pg);  (* will create new node automatically *)
  606.     if BTreeErrorOccurred then Exit;
  607.  
  608.     InsertNodeInList(iFName,fId,newNode,prevNode,nextNode,pRec);
  609.     if BTreeErrorOccurred then Exit;
  610.  
  611.     CreatedNode := newNode;         (* return the node ptr for this new node *)
  612.     end;                                       (* end of CreatedNode routine *)
  613.  
  614.  
  615. (* This routine will calculate and return the proper byte pointer position for
  616.    the given entry number.  The byte pointer position will be equal to the
  617.    location of the node pointer, not the value.                              *)
  618.  
  619. function BytePointerPosition(cnt : Byte;
  620.                              vSize : VSizeType) : PageRange;
  621.  
  622.     begin
  623.     BytePointerPosition := ((cnt - 1) * (vSize + RNSIZE)) + 1;
  624.     end;                                       (* end of BytePointerPosition *)
  625.  
  626. (*\*)
  627. (* This routine will return the entry number for the first entry in the node
  628.    which has a value equal to paramValue.  If no value matches paramValue, the
  629.    first entry which has a value greater than paramValue will be returned.  If
  630.    paramValue is greater than the last value in the node, then the last entry
  631.    number + 1 will be returned.  The routine will return 0 iff the particular
  632.    node contains no entries.                                                 *)
  633.  
  634. function BinarySearchEntry(var pg : SinglePage;        (* var for speed only *)
  635.                            var paramValue;
  636.                            var pRec : ParameterRecord  (* var for speed only *)
  637.                            ) : Byte;
  638.  
  639. var
  640.     startCnt,
  641.     midCnt,
  642.     maxCnt : Byte;
  643.  
  644.     begin
  645.     maxCnt := pg[VCNTLOC];
  646.     if maxCnt = 0 then
  647.         begin
  648.         BinarySearchEntry := 0;
  649.         Exit;
  650.         end;
  651.     if CompareValues(pg[RNSIZE + 1],paramValue,pRec.vType) <> LESSTHAN then
  652.         begin
  653.         BinarySearchEntry := 1;
  654.         Exit;
  655.         end;
  656.     if CompareValues(pg[((maxCnt - 1) * (pRec.vSize + RNSIZE)) +
  657.                          RNSIZE + 1],
  658.                      paramValue,
  659.                      pRec.vType) = LESSTHAN then
  660.         begin
  661.         BinarySearchEntry := maxCnt + 1;
  662.         Exit;
  663.         end;
  664.     startCnt := 1;
  665.     while startCnt < (maxCnt - 1) do
  666.         begin
  667.         midCnt := (maxCnt + startCnt) Div 2;
  668.         if CompareValues(pg[((midCnt - 1) * (pRec.vSize + RNSIZE)) +
  669.                          RNSIZE + 1],
  670.                          paramValue,
  671.                          pRec.vType) = LESSTHAN then
  672.             begin
  673.             startCnt := midCnt;
  674.             end
  675.         else
  676.             begin
  677.             maxCnt := midCnt;
  678.             end;
  679.         end;
  680.     BinarySearchEntry := maxCnt;
  681.     end;                                 (* end of BinarySearchEntry routine *)
  682.  
  683. (*\*)
  684. (* This routine will search an index node and return the record number for the
  685.    next lower node corresponding to the paramValue.  The returned node will
  686.    either be another index node or a sequence node.
  687.  
  688.    Note : this assumes that there are lower nodes.  Prior to calling this
  689.    routine check for an empty root                                           *)
  690.  
  691. function FindNextLevelPtr(var pg : SinglePage;         (* var for speed only *)
  692.                           var paramValue;
  693.                           var pRec : ParameterRecord   (* var for speed only *)
  694.                           ) : NodePtrType;
  695.  
  696.  var
  697.      cnt : Byte;
  698.      bytePtr : PageRange;
  699.      p : NodePtrType;                 (* temporarily holds pointer to return *)
  700.  
  701.      begin
  702.      cnt := BinarySearchEntry(pg,paramValue,pRec);
  703.      if cnt = 0 then
  704.          begin
  705.          bytePtr := 1;
  706.          end
  707.      else
  708.          begin
  709.          bytePtr := BytePointerPosition(cnt,pRec.vSize);
  710.          end;
  711.      Move(pg[bytePtr],p,RNSIZE);                       (* ptr to be returned *)
  712.      FindNextLevelPtr := p;
  713.      end;                                 (* end of FindNextLevelPtr routine *)
  714.  
  715.  
  716. (* This recursive routine will start at the specified node (rNum) and work
  717.    down the tree until the correct sequence node is found.  It will return
  718.    the record number of the sequence node.
  719.  
  720.    This routine assumes that as long as an index node is not empty, there
  721.    should be one more pointer than there are values.  In other words, there
  722.    is always a trailing valid pointer which takes care of the case of values
  723.    larger than the largest value in the tree.
  724.  
  725.    This routine also assumes that some sequence node exists.  This will not
  726.    work for an empty root.  This must be checked by caller.                  *)
  727.  
  728. function FindSNode(var iFName : FnString;              (* var for speed only *)
  729.                    var fId : File;                     (* var for speed only *)
  730.                    rNum : NodePtrType;
  731.                    var paramValue;
  732.                    var pRec : ParameterRecord          (* var for speed only *)
  733.                    ) : NodePtrType;
  734.  
  735. var
  736.     pg : SinglePage;
  737.  
  738.     begin
  739.     FetchPage(iFName,fId,rNum,pg);                                   (* get node *)
  740.     if BTreeErrorOccurred then Exit;
  741.  
  742.     if NodeType(pg[NTYPELOC]) = INDEXNODE then
  743.         begin
  744.         FindSNode := FindSNode(iFName,
  745.                                fId,
  746.                                FindNextLevelPtr(pg,paramValue,pRec),
  747.                                paramValue,pRec);
  748.         if BTreeErrorOccurred then Exit;
  749.         end
  750.     else
  751.         begin
  752.         FindSNode := rNum;
  753.         end;
  754.     end;                                        (* end of FindSNode function *)
  755.  
  756.  
  757. (*\*)
  758. (* This routine inserts a new value into a node.  It will locate the
  759.    proper place, move all values and pointers past the spot to allow room for
  760.    the new value and pointer, and insert the new value and pointer.  If there
  761.    is a value equal to this new value, the new value will be inserted in
  762.    front of the old one.  This routine will not work if there is not enough
  763.    room in the node.  This must be checked prior to calling this routine.
  764.    This routine works with both sequence and index nodes.  It assumes that the
  765.    proper page has been read in prior to this routine being called.  This is
  766.    why a page is passed in as a parameter in lieu of physical record number.
  767.  
  768.    This works for both index and sequence nodes                              *)
  769.  
  770. procedure InsertValueIntoNode(var pg : SinglePage;
  771.                               var paramValue;
  772.                               rNum : RecordNumber;
  773.                               nextNode : NodePtrType;     (* used for
  774.                                                              INDEXNODEs only *)
  775.                               var pRec : ParameterRecord);
  776.  
  777. var
  778.     cnt,
  779.     vCnt : Byte;
  780.     bytePtr : PageRange;
  781.     tempNode : NodePtrType;
  782.  
  783.     begin
  784.     vCnt := pg[VCNTLOC];                                  (* get value count *)
  785.     cnt := BinarySearchEntry(pg,paramValue,pRec);
  786.     if cnt = 0 then
  787.         begin                                               (* node is empty *)
  788.         bytePtr := 1;
  789.         end
  790.     else
  791.         begin
  792.         bytePtr := BytePointerPosition(cnt,pRec.vSize);
  793.         if NodeType(pg[NTYPELOC]) = INDEXNODE then
  794.             begin                        (* find correct place in index node *)
  795.             Move(pg[bytePtr],tempNode,RNSIZE);
  796.             while (tempNode <> nextNode) and (cnt <= vCnt) do
  797.                 begin
  798.                 bytePtr := bytePtr + pRec.vSize + RNSIZE;
  799.                 Move(pg[bytePtr],tempNode,RNSIZE);
  800.                 Inc(cnt);
  801.                 end;
  802.             end;
  803.         end;
  804.     Move(pg[bytePtr],                                          (* make room *)
  805.          pg[bytePtr + pRec.vSize + RNSIZE],
  806.          (((vCnt - cnt) + 1) * (pRec.vSize + RNSIZE)) + RNSIZE);
  807.     Move(rNum,pg[bytePtr],RNSIZE);                         (* insert pointer *)
  808.     Move(paramValue,pg[bytePtr + RNSIZE],pRec.vSize);          (*insert value*)
  809.     pg[VCNTLOC] := vCnt + 1;                              (* new value count *)
  810.     if mustMoveCursor and (cnt <= pRec.cursor.entryNum) then
  811.         begin
  812.         Inc(pRec.cursor.entryNum);
  813.         end;
  814.     end;                               (* end of InsertValueIntoNode routine *)
  815.  
  816. (*\*)
  817. (* This routine will calculate and return the maximum number of entries which
  818.    will fit in an index node.                                                *)
  819.  
  820. function MaxEntries(vSize : VSizeType) : Byte;
  821.  
  822.     begin
  823.     MaxEntries := (MAXUSABLE - RNSIZE) Div (vSize + RNSIZE);
  824.     end;                                        (* end of MaxEntries routine *)
  825.  
  826.  
  827. (* This routine will move n/2 (rounded down) values from the right node
  828.    (rtNode) to the empty left node (ltNode).                                 *)
  829.  
  830. procedure MoveValues(var rtPage : SinglePage;
  831.                      var ltPage : SinglePage;
  832.                      ltNode : NodePtrType;
  833.                      var pRec : ParameterRecord);
  834.  
  835. var
  836.     bytesToMove,                            (* total number of bytes to move *)
  837.     numToMove,                                   (* number of values to move *)
  838.     vCnt : Byte;                            (* count of values in right node *)
  839.  
  840.     begin
  841.     vCnt := rtPage[VCNTLOC];                       (* get right node's count *)
  842.     numToMove := vCnt Div 2;
  843.     bytesToMove := (RNSIZE + pRec.vSize) * numToMove;     (* calc # of bytes
  844.                                                                      to move *)
  845.     Move(rtPage[1],ltPage[1],bytesToMove);
  846.     Move(rtPage[bytesToMove + 1],rtPage[1],MAXUSABLE - bytesToMove);
  847.     Dec(vCnt,numToMove);
  848.     if NodeType(rtPage[NTYPELOC]) = INDEXNODE then
  849.         begin
  850.         FillChar(rtPage[(vCnt * (pRec.vSize + RNSIZE)) + 1 + RNSIZE],
  851.                  numToMove * (pRec.vSize + RNSIZE),
  852.                  0);
  853.         end
  854.     else
  855.         begin
  856.         FillChar(rtPage[(vCnt * (pRec.vSize + RNSIZE)) + 1],
  857.                  numToMove * (pRec.vSize + RNSIZE),
  858.                  0);
  859.         end;
  860.     rtPage[VCNTLOC] := vCnt;
  861.     ltPage[VCNTLOC] := numToMove;
  862.     if mustMoveCursor then
  863.         begin
  864.         if numToMove < pRec.cursor.entryNum then
  865.             begin
  866.             Dec(pRec.cursor.entryNum,numToMove);
  867.             end
  868.         else
  869.             begin
  870.             pRec.cursor.prNum := ltNode;
  871.             end;
  872.         end;
  873.     end;                                        (* end of MoveValues routine *)
  874.  
  875. (*\*)
  876. (* This recursive routine will start at a given node (usually the root) and
  877.    follow the tree down until the correct sequence node is found.  The new
  878.    value and record number will be inserted into the correct sequence node.
  879.    In the event that the sequence node is full, the node will be split.  The
  880.    value and record number will be put in the proper node if a split occurs.
  881.    The routine will return NULL if no split occurs.  If a split occurs, the
  882.    record number (node pointer) of the newly created node will be returned.
  883.    This new node will be inserted in the parent index node.  If it won't
  884.    fit the index node will be split and the new child record number will
  885.    be inserted in the proper index node.  The value associated with the child
  886.    record number is the largest value in the newly created child node.  This
  887.    process continues until we bubble back to the root in the node.  Once at
  888.    the root the routine will return back to the original caller.  If the root
  889.    was not split then NULL will be returned.  If the root was split, then the
  890.    newly created child record number is returned.  The caller will have to
  891.    create a new root node and insert the new value and the child record
  892.    number.  Be sure that the caller also inserts the newly inserted child's
  893.    right sibling (record number only) since all indexes have one more pointer
  894.    than they do values.
  895.  
  896.    This routine expects at least one pointer in the root.  This needs to be
  897.    checked by the caller.                                                    *)
  898.  
  899. function InsertValue(var iFName : FnString;            (* var for speed only *)
  900.                      var fId : File;                   (* var for speed only *)
  901.                      rNum : RecordNumber;    (* record number to be inserted *)
  902.                      var paramValue;                 (* value to be inserted *)
  903.                      thisNode : NodePtrType;                         (* node *)
  904.                      var pRec : ParameterRecord) : NodePtrType;
  905.  
  906. var
  907.     newNode,                    (* newly created node if needed (node split) *)
  908.     lowerNode : NodePtrType;
  909.     thisPage,
  910.     newPage,
  911.     lowerPage : SinglePage;
  912.     lastValLoc : PageRange;                  (* used to hold buffer position *)
  913.     nextNode : NodePtrType;
  914.     comp : Comparison;
  915.  
  916.     function NewPageContainsNodePtr : Boolean;
  917.  
  918.     var
  919.         cnt,
  920.         bytePtr : PageRange;
  921.         tempNode : NodePtrType;
  922.  
  923.         begin
  924.         bytePtr := 1;
  925.         for cnt := 1 to newPage[VCNTLOC] do
  926.             begin
  927.             Move(newPage[bytePtr],tempNode,RNSIZE);
  928.             if tempNode = nextNode then
  929.                 begin
  930.                 NewPageContainsNodePtr := TRUE;
  931.                 Exit;
  932.                 end;
  933.             bytePtr := bytePtr + pRec.vSize + RNSIZE;
  934.             end;
  935.         NewPageContainsNodePtr := FALSE;
  936.         end;
  937.  
  938.     begin
  939.     FetchPage(iFName,fId,thisNode,thisPage);
  940.     if BTreeErrorOccurred then Exit;
  941.  
  942.     case NodeType(thisPage[NTYPELOC]) of
  943.         INDEXNODE:
  944.             begin
  945.             lowerNode := InsertValue(iFName,fId,rNum,paramValue,
  946.                                      FindNextLevelPtr(thisPage,paramValue,
  947.                                                       pRec),pRec);
  948.             if BTreeErrorOccurred then Exit;
  949.  
  950.             if lowerNode <> NULL then
  951.                 begin                     (* lower node must have been split *)
  952.                 FetchPage(iFName,fId,lowerNode,lowerPage);
  953.                 if BTreeErrorOccurred then Exit;
  954.                 lastValLoc := (((lowerPage[VCNTLOC] - 1)
  955.                               * ( pRec.vSize + RNSIZE)) + RNSIZE) + 1;
  956.                 Move(lowerPage[NEXTLOC],nextNode,RNSIZE);
  957.                 if MaxEntries(pRec.vSize) > thisPage[VCNTLOC] then
  958.                     begin                                         (* it fits *)
  959.                     InsertValueIntoNode(thisPage,lowerPage[lastValLoc],
  960.                                         lowerNode,nextNode,pRec);
  961.                     InsertValue := NULL;    (* node not split .. return NULL *)
  962.                     end
  963.                 else
  964.                     begin
  965.                     newNode := CreatedNode(iFName,
  966.                                            fId,
  967.                                            thisPage[PREVLOC],
  968.                                            thisNode,
  969.                                            INDEXNODE,
  970.                                            pRec);
  971.                     if BTreeErrorOccurred then Exit;
  972.                     FetchPage(iFName,fId,thisNode,thisPage);     (* required *)
  973.                     if BTreeErrorOccurred then Exit;
  974.                     FetchPage(iFName,fId,newNode,newPage);
  975.                     if BTreeErrorOccurred then Exit;
  976.                     MoveValues(thisPage,newPage,newNode,pRec);
  977.                     comp := CompareValues(lowerPage[lastValLoc],
  978.                                           thisPage[RNSIZE + 1],
  979.                                           pRec.vType);(* which page is it in *)
  980.                     if comp = EQUALTO then
  981.                         begin
  982.                         if NewPageContainsNodePtr then
  983.                             begin
  984.                             comp := LESSTHAN;
  985.                             end
  986.                         else
  987.                             begin
  988.                             comp := GREATERTHAN;
  989.                             end;
  990.                         end;
  991.                     if comp = LESSTHAN then
  992.                         begin
  993.                         InsertValueIntoNode(newPage,
  994.                                             lowerPage[lastValLoc],
  995.                                             lowerNode,nextNode,pRec);
  996.                         end
  997.                     else
  998.                         begin
  999.                         InsertValueIntoNode(thisPage,
  1000.                                             lowerPage[lastValLoc],
  1001.                                             lowerNode,nextNode,pRec);
  1002.                         end;
  1003.                     StorePage(iFName,fId,newNode,newPage);
  1004.                     if BTreeErrorOccurred then Exit;
  1005.                     InsertValue := newNode;      (* newly added node will be
  1006.                                                     returned                 *)
  1007.                     end;
  1008.                 StorePage(iFName,fId,thisNode,thisPage);
  1009.                 if BTreeErrorOccurred then Exit;
  1010.                 end
  1011.             else
  1012.                 begin
  1013.                 InsertValue := NULL;    (* it fit at lower level therefore
  1014.                                            this level is fine .. return NULL *)
  1015.                 end;
  1016.             end;
  1017.         SEQUENCENODE :
  1018.             begin
  1019.             mustMoveCursor := pRec.cursor.valid and
  1020.                               (pRec.cursor.prNum = thisNode);
  1021.             if MaxEntries(pRec.vSize) > thisPage[VCNTLOC] then
  1022.                 begin                                             (* it fits *)
  1023.                 InsertValueIntoNode(thisPage,paramValue,rNum,NULL,pRec);
  1024.                 InsertValue := NULL;   (* it fits .. no split .. return NULL *)
  1025.                 end
  1026.             else
  1027.                 begin
  1028.                 newNode := CreatedNode(iFName,
  1029.                                        fId,
  1030.                                        thisPage[PREVLOC],
  1031.                                        thisNode,
  1032.                                        SEQUENCENODE,
  1033.                                        pRec);
  1034.                 if BTreeErrorOccurred then Exit;
  1035.                 FetchPage(iFName,fId,thisNode,thisPage);         (* required *)
  1036.                 if BTreeErrorOccurred then Exit;
  1037.                 FetchPage(iFName,fId,newNode,newPage);
  1038.                 if BTreeErrorOccurred then Exit;
  1039.                 MoveValues(thisPage,newPage,newNode,pRec);
  1040.                 if CompareValues(paramValue,thisPage[RNSIZE + 1],
  1041.                                  pRec.vType) = GREATERTHAN then
  1042.                     begin
  1043.                     InsertValueIntoNode(thisPage,paramValue,rNum,NULL,pRec);
  1044.                     end
  1045.                 else
  1046.                     begin
  1047.                     InsertValueIntoNode(newPage,paramValue,rNum,NULL,pRec);
  1048.                     end;
  1049.                 StorePage(iFName,fId,newNode,newPage);
  1050.                 if BTreeErrorOccurred then Exit;
  1051.                 InsertValue := newNode;
  1052.                 end;
  1053.             StorePage(iFName,fId,thisNode,thisPage);
  1054.             mustMoveCursor := FALSE;
  1055.             end;
  1056.         end;                                   (* end of case statement      *)
  1057.     end;                                       (* end of InsertValue routine *)
  1058.  
  1059. (*\*)
  1060. (* This routine will locate and delete a value and its associated record
  1061.    pointer from within a node/list of nodes.  It will first locate the value.
  1062.    The value will be found in this node or in succeeding nodes. The search will
  1063.    continue until the value and the correct associated record number are found
  1064.    or it is determined that it does not exist.If the correct value and record
  1065.    number are not found then the routine will return FALSE indicating that no
  1066.    value was deleted.  If the correct value and record number are found they
  1067.    will be deleted.  In this case the node where the value was deleted from
  1068.    will be returned.  If the value deleted was the last in the node or the
  1069.    only one in the node these facts will be returned.  This is important
  1070.    because the calling node may have to alter or delete values as a result.
  1071.  
  1072.    note : if a node is the last node in a level node list the node will not
  1073.    be deleted.  In this case the value will be deleted but last will be set
  1074.    to FALSE.  This is because the parent needs to make no adjustment.        *)
  1075.  
  1076. function DeleteValueFromNode(var iFName : FnString;    (* var for speed only *)
  1077.                              var fId : File;           (* var for speed only *)
  1078.                              rNum : RecordNumber;
  1079.                              var paramValue;
  1080.                              var thisNode : NodePtrType;
  1081.                              var pRec : ParameterRecord;
  1082.                              var last : Boolean;
  1083.                              var nodeDeleted : Boolean) : Boolean;
  1084.  
  1085. var
  1086.     done : Boolean;
  1087.     cnt,
  1088.     vCnt : Byte;
  1089.     bytePtr : PageRange;
  1090.     pg : SinglePage;
  1091.     nextNode : NodePtrType;
  1092.     recNum : RecordNumber;
  1093.  
  1094.     begin
  1095.     FetchPage(iFName,fId,thisNode,pg);           (* fetch page for this node *)
  1096.     if BTreeErrorOccurred then Exit;
  1097.  
  1098.     vCnt := pg[VCNTLOC];                                  (* get value count *)
  1099.     cnt := BinarySearchEntry(pg,paramValue,pRec);
  1100.     if (cnt <> 0) and (cnt <= vCnt) then
  1101.         begin
  1102.         bytePtr := BytePointerPosition(cnt,pRec.vSize);
  1103.         done := FALSE;
  1104.         end
  1105.     else
  1106.         begin                                  (* no such value in this node *)
  1107.         DeleteValueFromNode := FALSE;
  1108.         last := FALSE;
  1109.         nodeDeleted := FALSE;
  1110.         done := TRUE;
  1111.         end;
  1112.     while not done do
  1113.         begin
  1114.         if CompareValues(paramValue,
  1115.                          pg[bytePtr + RNSIZE],
  1116.                          pRec.vType) = LESSTHAN then
  1117.             begin
  1118.             done := TRUE;
  1119.             DeleteValueFromNode := FALSE;
  1120.             last := FALSE;
  1121.             nodeDeleted := FALSE;
  1122.             end
  1123.         else
  1124.             begin             (* value found .. look for record number match *)
  1125.             Move(pg[bytePtr],recNum,RNSIZE);
  1126.             if rNum = recNum then
  1127.                 begin                           (* record number match found *)
  1128.                 done := TRUE;
  1129.                 DeleteValueFromNode := TRUE;
  1130.                 Move(pg[NEXTLOC],nextNode,RNSIZE);
  1131.                 if (vCnt = 1) and (nextNode <> NULL) then
  1132.                     begin                       (* only 1 entry in this node *)
  1133.                     last := TRUE;
  1134.                     nodeDeleted := TRUE;
  1135.                     end
  1136.                 else
  1137.                     begin
  1138.                     pg[VCNTLOC] := vCnt - 1;
  1139.                     Move(pg[bytePtr + RNSIZE + pRec.vSize],
  1140.                          pg[bytePtr],
  1141.                          (RNSIZE + pRec.vSize) * (vCnt - cnt) + RNSIZE);
  1142.                     FillChar(pg[(((vCnt - 1) * (pRec.vSize + RNSIZE)) + 1) +
  1143.                              RNSIZE],
  1144.                              pRec.vSize + RNSIZE,
  1145.                              0);
  1146.                     StorePage(iFName,fId,thisNode,pg);     (* store the page *)
  1147.                     if BTreeErrorOccurred then Exit;
  1148.                     nodeDeleted := FALSE;
  1149.                     last := (cnt = vCnt) and (vCnt <> 1) and (nextNode <> NULL);
  1150.                              (* the nextNode check is used since the last node
  1151.                              at level only has a node pointer and not a
  1152.                              corresponding value at the  next higher level.
  1153.                              Therefore, no value adjustment will be required *)
  1154.                     end;
  1155.                 if mustMoveCursor then
  1156.                     begin
  1157.                     if pRec.cursor.entryNum > cnt then
  1158.                         begin
  1159.                         Dec(pRec.cursor.entryNum);
  1160.                         end
  1161.                     else
  1162.                         begin
  1163.                         if pRec.cursor.entryNum = cnt then
  1164.                             begin
  1165.                             Dec(pRec.cursor.entryNum);
  1166.                             if pRec.cursor.entryNum = 0 then
  1167.                                 begin
  1168.                                 pREc.cursor.valid := FALSE;
  1169.                                 end;
  1170.                             end;
  1171.                         end;
  1172.                     end;
  1173.                 end;
  1174.             end;
  1175.         if not done then
  1176.             begin
  1177.             if (cnt = vCnt) then
  1178.                 begin                       (* no more values .. get brother *)
  1179.                 Move(pg[NEXTLOC],thisNode,RNSIZE);            (* get brother *)
  1180.                 if thisNode = NULL then
  1181.                     begin                              (* no brother .. quit *)
  1182.                     done := TRUE;
  1183.                     DeleteValueFromNode := FALSE;
  1184.                     last := FALSE;
  1185.                     nodeDeleted := FALSE;
  1186.                     end
  1187.                 else
  1188.                     begin                                   (* brother found *)
  1189.                     FetchPage(iFName,fId,thisNode,pg);      (* fetch brother *)
  1190.                     if BTreeErrorOccurred then Exit;
  1191.                     vCnt := pg[VCNTLOC];
  1192.                     if vCnt = 0 then        (* check to see if node is empty *)
  1193.                         begin                           (* if so we are done *)
  1194.                         done := TRUE;
  1195.                         DeleteValueFromNode := FALSE;
  1196.                         last := FALSE;
  1197.                         nodeDeleted := FALSE;
  1198.                         end
  1199.                     else
  1200.                         begin
  1201.                         bytePtr := 1;
  1202.                         cnt := 1;
  1203.                         end;
  1204.                     end;
  1205.                 end
  1206.             else
  1207.                 begin
  1208.                 Inc(cnt);
  1209.                 bytePtr := bytePtr + RNSIZE + pRec.vSize;
  1210.                 end;
  1211.             end;
  1212.         end;
  1213.     end;                               (* end of DeleteValueFromNode routine *)
  1214.  
  1215. (*\*)
  1216. (* This recursive routine will start at a given node (initially the root) and
  1217.    follow the tree down until the correct sequence node is found.  Once it
  1218.    is found DeleteValueFromNode is used to delete the value from the node if
  1219.    it exists.  The routine returns TRUE if the value (including the correct
  1220.    physical record pointer) is found and deleted or if the last entry in the
  1221.    node was changed to a new value because of a deletion in a lower node.
  1222.    Otherwise, FALSE is returned.  If this deletion causes an empty node,
  1223.    DeleteValueFromNode will delete the node.  This routine will take this into
  1224.    account and delete the lowernode and lowernode node pointer.  The variable
  1225.    nodeDeleted will be set TRUE by DeleteValueFromNode to denote that the
  1226.    lower node was deleted.  If the lower node was not deleted but the value
  1227.    deleted was the last value in the node (not the only value but the last)
  1228.    and was not the last node of a given level then this routine will change
  1229.    the value pointing to the lower node to take this into account.  This will
  1230.    be noted by last being set to TRUE by DeleteValueFromNode.                *)
  1231.  
  1232. function DeleteValue(var iFName : FnString;            (* var for speed only *)
  1233.                      var fId : File;                   (* var for speed only *)
  1234.                      rNum : RecordNumber;
  1235.                      var paramValue;
  1236.                      var thisNode : NodePtrType;
  1237.                      var pRec : ParameterRecord;
  1238.                      var last : Boolean;
  1239.                      var nodeDeleted : Boolean) : Boolean;
  1240.  
  1241. var
  1242.     lowerPage,
  1243.     thisPage : SinglePage;
  1244.     lastValLoc,
  1245.     bytePtr : PageRange;
  1246.     lowerNode : NodePtrType;
  1247.     cnt : Byte;
  1248.  
  1249.     begin
  1250.     FetchPage(iFName,fId,thisNode,thisPage);
  1251.     if BTreeErrorOccurred then Exit;
  1252.  
  1253.     case NodeType(thisPage[NTYPELOC]) of
  1254.         INDEXNODE :
  1255.             begin
  1256.             lowerNode := FindNextLevelPtr(thisPage,paramValue,pRec);
  1257.             if DeleteValue(iFName,
  1258.                            fId,
  1259.                            rNum,
  1260.                            paramValue,
  1261.                            lowerNode,      (* will become the lower node where
  1262.                                                   the value was deleted from *)
  1263.                            pRec,
  1264.                            last,
  1265.                            nodeDeleted) then
  1266.                 begin      (* value was successfully deleted from node below *)
  1267.                 if BTreeErrorOccurred then Exit;
  1268.                 if nodeDeleted then    (* check to see if lower node deleted *)
  1269.                     begin              (* it was - delete corresponding node
  1270.                                           pointer from this node             *)
  1271.                     DeleteValue := DeleteValueFromNode(iFName,
  1272.                                                        fId,
  1273.                                                        lowerNode,  (*lower node
  1274.                                                                     pointer *)
  1275.                                                        paramValue,
  1276.                                                        thisNode,  (* node to
  1277.                                                                      delete
  1278.                                                                      from *)
  1279.                                                        pRec,
  1280.                                                        last,
  1281.                                                        nodeDeleted);
  1282.                     if BTreeErrorOccurred then Exit;
  1283.                     DeleteNodeFromList(iFName,fId,lowerNode,pRec);
  1284.                                               (* delete lower node from list *)
  1285.                     if BTreeErrorOccurred then Exit;
  1286.                     end
  1287.                 else
  1288.                     begin                               (* node not deleted *)
  1289.                     if last then         (* value deleted was last entry in
  1290.                                             lower node and lower node was not
  1291.                                             last at that level .. therefore we
  1292.                                             need to change the value
  1293.                                             corresponding to the new last
  1294.                                             value in the lower node          *)
  1295.                         begin
  1296.                         bytePtr := 1;
  1297.                         cnt := BinarySearchEntry(thisPage,paramValue,pRec);
  1298.                         bytePtr := BytePointerPosition(cnt,pRec.vSize);
  1299.                                              (* now find record number match *)
  1300.                         if CompareValues(lowerNode,
  1301.                                          thisPage[bytePtr],
  1302.                                          LONGINTVALUE) = EQUALTO then
  1303.                                 (* It is not obvious, but if the first entry
  1304.                                    for paramValue is not the one that matches
  1305.                                    the lower node, no adjustment will be
  1306.                                    required.  This is because, if the lower node
  1307.                                    is not the first node with this value, the
  1308.                                    new last value for the lower node will be
  1309.                                    paramValue                                *)
  1310.                             begin
  1311.                             FetchPage(iFName,fId,lowerNode,lowerPage);
  1312.                             if BTreeErrorOccurred then Exit;
  1313.                             lastValLoc := ((lowerPage[VCNTLOC] - 1)
  1314.                                           * (pRec.vSize + RNSIZE)) + 1;
  1315.                             Move(lowerPage[lastValLoc + RNSIZE],
  1316.                                  thisPage[bytePtr + RNSIZE],
  1317.                                  pRec.vSize);
  1318.                             StorePage(iFName,fId,thisNode,thisPage);
  1319.                             if BTreeErrorOccurred then Exit;
  1320.                             last := (cnt = thisPage[VCNTLOC]);
  1321.                             end
  1322.                         else
  1323.                             begin
  1324.                             last := FALSE;
  1325.                             end;
  1326.                         end;
  1327.                     DeleteValue := last;
  1328.                     end;
  1329.                 end
  1330.             else
  1331.                 begin     (* no deletion/adjustment performed at lower level *)
  1332.                 if BTreeErrorOccurred then Exit;
  1333.                 DeleteValue := FALSE;
  1334.                 end;
  1335.             end;
  1336.         SEQUENCENODE :
  1337.             begin
  1338.             mustMoveCursor := pRec.cursor.valid and
  1339.                               (pRec.cursor.prNum = thisNode);
  1340.             DeleteValue := DeleteValueFromNode(iFName,fId,rNum,paramValue,
  1341.                                                thisNode,pRec,last,nodeDeleted);
  1342.             mustMoveCursor := FALSE;
  1343.             end;
  1344.         end;                                        (* end of case statement *)
  1345.     end;                                       (* end of DeleteValue routine *)
  1346.  
  1347.  
  1348.  
  1349. {$I dfbtree.inc}         (* The rest of the btree routines                     *)
  1350.  
  1351.  
  1352. begin
  1353. mustMoveCursor := FALSE;
  1354. end.                                                    (* end of BTree unit *)
  1355.